00100	;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00200		A←1↔B←2↔C←3
00300	INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
00400		IGNORE:0↔DPYPTR:0↔BUFEND:0
00500		BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
00600	;--------------------------------------------------------------
00650	INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT
00700	DPYSET:	LAC 1,ARG1↔CDR 2,-1(1)	;BUFFER SIZE.
00800		ADDI 2,-1(1)↔DAC 2,BUFEND
00900		ADDI 1,2↔DAC 1,BUFHD	;POINT TO THIRD WORD.
01000		SETZM IGNORE
01100	CLR2:	LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
01200		LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
01300		PUSH P,(P)↔GO LV3
01400	;--------------------------------------------------------------
01500	DPYBIG:	SKIPE IGNORE↔POP1J
01600		LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
01700		PUSH P,(P)↔GO LV2
01800	
01900	DPYBRT:	SKIPE IGNORE↔POP1J
02000		LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
02100		PUSH P,(P)↔GO LV2
02200	;--------------------------------------------------------------
02300	AIVECT:	SKIPA C,[146]	;INVISIBLE ABSOLUTE.
02400	AVECT:	LACI C,106
02500		SKIPGE IGNORE↔POP2J
02600	LV:	LAC A,ARG2↔LAC B,ARG1
02700	LVC:	DPB A,[POINT 11,C,10]
02800		DPB B,[POINT 11,C,21]
02900	LV2:	AOS A,DPYPTR↔DAC C,(A)
03000	LV3:	LIPI A,<(<POINT 7,0,35>)>
03100		DAC A,DPYPTR↔LACI A,(A)
03200		CAML A,BUFEND↔SETOM IGNORE
03300		POP2J
03400	;--------------------------------------------------------------
03500	DPYSTR:	LAC 3,ARG1↔LIPI 3,440700
03600		ILDB 3↔JUMPE POP1J.
03700		CALL(DTYO,0)↔GO DPYSTR+2
03800	
03900	DTYO:	LAC 1,ARG1↔IDPB 1,DPYPTR
04000		CDR 1,DPYPTR↔CAML 1,BUFEND
04100		SETOM IGNORE↔POP1J
04200	;--------------------------------------------------------------
04300	DPYOUT:	SKIPN 1,BUFHD↔GO .+6
04400		LAC 2,DPYPTR↔DAC 2,-2(1)
04500		LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
04600		CDR B,DPYPTR↔SUB B,BUFHD
04700		AOS B↔DAC B,BUFHD+1
04800		LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
04900		POP1J
05000	;--------------------------------------------------------------
     

00100	SUBR(DECDPY)NUMBER------------------------------------------------
00200	BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300		LAC 1,ARG1↔POP P,ARG1	        ;GET ARG AND ADJUST STACK.
00400	L1:	JUMPGE 1,L2			;TEST FOR NEGATIVE NUMBER.
00500		MOVM 2,1↔CALL(DTYO,["-"])	;PRINT MINUS SIGN.
00600		LAC 1,2
00700	L2:	IDIVI 1,12↔PUSH P,2		;MODULO TEN AND SAVE.
00800		SKIPE 1↔PUSHJ P,L2		;TEST FOR DONE.
00900		POP P,1↔ADDI 1,60↔CALL(DTYO,1)	;RESTORE & PRINT.
01000		POP0J
01100	BEND;12/17/72-----------------------------------------------------
01200	
01300	SUBR(FLODPY)FLONUM,PLACES-----------------------------------------
01400	BEGIN FLODPY;FLOATING NUMBER DISPLAY - BGB - 4 FEB 1973.
01500		LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
01600		LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
01700		FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
01800		IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
01900		PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
02000		ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
02100		PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
02200		LACI "."↔IDPB 0,1↔POP2J↔LIT
02300	BEND;2/4/73-------------------------------------------------------
     

00100	SUBR(IIIDPY)WORLD-------------------------------------------------
00200	BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
00300	;BGB - 5 FEBRUARY 1973.
00400		E←←16
00500		CALL(DPYSET,DPYBUF)
00600		LAC E,ARG1
00700	L1:	POTEN E,E	;CDR THRU THE VISIBLE EDGE LIST.
00800		JUMPE E,[
00900		CALL(DPYOUT,[1])
01000		POP1J]	;EXIT.
01100		X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
01200		X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
01300		GO L1
01400	BEND;2/5/73-------------------------------------------------------
     

00100	;VERNIER III TEXT POSITIONING.
00200		VERNX ←← 14
00300		VERNY ←← 11
00400	SUBR(VDPY)V-------------------------------------------------------
00500	BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
00600		LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400	;NSEW & PZZ.
00700		SKIPE↔POP1J
00800		XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
00900		YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
01000		CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01100		CALL(IDPY,ARG1)
01200		CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
01300		POP1J
01400	BEND;2/9/73-------------------------------------------------------
01500	
01600	SUBR(EDPY)E-------------------------------------------------------
01700	BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
01800		CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01900		LAC 2,ARG1
02000		PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
02100		XDC 0,1↔FIXX↔DAC X↔PUSH P,0
02200		YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
02225		PUSH P,ARG1↔PUSH P,ARG1
02250		PUSHJ P,AIVECT
02300		CALL(DTYO,["+"])↔CALL(AIVECT)
02400	L1:	LAC 2,ARG1
02500		NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
02600		XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
02700		YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
02800		CALL(DTYO,["-"])
02900	L2:	LAC 2,ARG1
03000		LAC X↔ASH -1↔PUSH P,0
03100		LAC Y↔ASH -1↔PUSH P,0
03200		CALL(AIVECT)↔CALL(IDPY,ARG1)
03300		CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
03400		POP1J
03450	DECLARE{X,Y}
03500	BEND;2/9/73-------------------------------------------------------
03600	
     

00100	SUBR(FDPY)F-------------------------------------------------------
00200	BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
00300		LAC 1,ARG1↔DAC 1,F
00400		TEST 1,FBIT↔POP1J
00500		PED 2,1↔DAC 2,E↔DAC 2,E0
00700		SETZM I
00800		CALL(DPYBIG,[1])
00900		CALL(DPYBRT,[3])
00950		SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
01000	L1:	AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
01100		X1DC 0,2↔DAC 0,X
01200		Y1DC 1,2↔DAC 1,Y
01300		CALL(AIVECT,0,1)↔LAC 2,E
01400		X2DC 0,2↔ADDM 0,X
01500		Y2DC 1,2↔ADDM 1,Y
01600		CALL(AVECT,0,1)
01700		LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
01800		LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
01900		CALL(AIVECT,0,1)
02000		CALL(DECDPY,I)
02100	L2:	CALL(ECCW,E,F)
02150		CAMN 1,E↔GO L3↔DAC 1,E
02200		CAME 1,E0↔GO L1
02300	L3:	CALL(DPYBRT,[2])
02400		CALL(DPYBIG,[2])
02500		POP1J
02600		DECLARE{F,E,E0,X,Y,I}
02700	BEND;2/9/73-------------------------------------------------------
     

00100	END SA